home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol160 / printper.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-12-16  |  7.2 KB  |  268 lines
  1. 90  WIDTH "scrn:", 80
  2. 95  SCREEN 0,1,0,0
  3. 100  TITLE$ = "Print the Persons and Ordinances File Program"
  4. 105  TITLE$ = TITLE$ + " ON DISPLAY"
  5. 110  VERSION$ = "Version 3.1"
  6. 115  COPY1$ = "Copyright (c) 1983, 1984, 1985, by:"
  7. 120  COPY2$ = "Melvin O. Duke"
  8. 125  PRICE$ = "$35"
  9. 130  ADDR1$ = "Melvin O. Duke"
  10. 135  ADDR2$ = "P. O. Box 20836"
  11. 140  ADDR3$ = "San Jose, CA  95160"
  12. 145  REM Dimension Statements go here
  13. 170  REM Produce the first screen
  14. 175  KEY OFF : CLS
  15. 180  REM Draw the outer double box
  16. 185  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
  17. 190  REM Find the title location
  18. 195  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  19. 200  REM Draw the title box
  20. 205  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
  21. 210  REM Print the title
  22. 215  LOCATE 4,TITLE.POS : PRINT TITLE$
  23. 220  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  24. 225  REM Draw the Contribution box
  25. 230  R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
  26. 235  REM Request the Contribution
  27. 240  LOCATE 9,23 : PRINT "If you are using these programs, and"
  28. 245  LOCATE 10,21 : PRINT "finding them of value, your contribution"
  29. 250  LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be anticipated."
  30. 255  REM Draw the Mailing Label
  31. 260  R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
  32. 265  REM Print the Name and Address
  33. 270  LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
  34. 275  LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
  35. 280  LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
  36. 285  REM Draw the Copyright box
  37. 290  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 400
  38. 295  REM Print the Copyright
  39. 300  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  40. 305  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  41. 310  GOTO 740
  42. 400  REM subroutine to print a double box
  43. 405  COLOR 5
  44. 410  FOR I = R1 + 1 TO R2 - 1
  45. 420   LOCATE I, C1 : PRINT CHR$(186);
  46. 430   LOCATE I, C2 : PRINT CHR$(186);
  47. 440  NEXT I
  48. 450  FOR J = C1 + 1 TO C2 - 1
  49. 460   LOCATE R1, J : PRINT CHR$(205);
  50. 470   LOCATE R2, J : PRINT CHR$(205);
  51. 480  NEXT J
  52. 490   LOCATE R1, C1 : PRINT CHR$(201);
  53. 500   LOCATE R1, C2 : PRINT CHR$(187);
  54. 510   LOCATE R2, C1 : PRINT CHR$(200);
  55. 520   LOCATE R2, C2 : PRINT CHR$(188);
  56. 525  COLOR 7
  57. 530  RETURN
  58. 600  REM subroutine to print a single box
  59. 605  COLOR 3
  60. 610  FOR I = R1 + 1 TO R2 - 1
  61. 620   LOCATE I, C1 : PRINT CHR$(179);
  62. 630   LOCATE I, C2 : PRINT CHR$(179);
  63. 640  NEXT I
  64. 650  FOR J = C1 + 1 TO C2 - 1
  65. 660   LOCATE R1, J : PRINT CHR$(196);
  66. 670   LOCATE R2, J : PRINT CHR$(196);
  67. 680  NEXT J
  68. 690   LOCATE R1, C1 : PRINT CHR$(218);
  69. 700   LOCATE R1, C2 : PRINT CHR$(191);
  70. 710   LOCATE R2, C1 : PRINT CHR$(192);
  71. 720   LOCATE R2, C2 : PRINT CHR$(217);
  72. 725  COLOR 7
  73. 730  RETURN
  74. 740  REM ask user to press a key to continue
  75. 750  LOCATE 25,1
  76. 760  PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
  77. 770  K$ = INKEY$ : IF K$ = "" THEN 770
  78. 780  CLS
  79. 1000  REM Print the Persons and Ordinances File Program.
  80. 1010  REM By:  Melvin O. Duke.  Last Updated:  01 August 1985.
  81. 1020  OPEN "a:ordfile" AS #2 LEN = 256
  82. 1030  FIELD 2,5ASO1$,11ASO2$,11ASO3$,11ASO4$,5ASO5$,5ASO6$,11ASO7$,11ASO8$,11ASO9$,11ASO10$,11ASO11$,5ASO12$,11ASO13$,11ASO14$,11ASO15$,11ASO16$,11ASO17$,11ASO18$,11ASO19$,11ASO20$,11ASO21$,11ASO22$,11ASO23$,26ASO24$
  83. 1040  REM
  84. 1050  OPEN "a:persfile" AS #1 LEN = 256
  85. 1060  FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  86. 1070  REM Read all records, and print the actual ones
  87. 1080  CLS
  88. 1090  LOCATE 23,1
  89. 1100  INPUT "Enter the Record Number to be Printed (0 to quit) or 'all'";REPLY$
  90. 1110  IF LEFT$(REPLY$,1) = "a" OR LEFT$(REPLY$,1) = "A" THEN 1160
  91. 1120  I = VAL(REPLY$)
  92. 1130  IF I = 0 THEN 2360
  93. 1140  GOSUB 1190  'to print
  94. 1150  GOTO 1080
  95. 1160  FOR I = 1 TO 500
  96. 1170  GOSUB 1190
  97. 1180  GOTO 2350
  98. 1190  GET #1, I
  99. 1200  CLS
  100. 1210  LOCATE 23,1 : PRINT "Processing Record #";I
  101. 1260  REM Extract information from the file for use
  102. 1270  T1 = CVS(F1$)
  103. 1280  IF T1 < 1 THEN 2340  'return
  104. 1281  REM Print a Title on Each Page
  105. 1282  LPRINT ,"Content of the Persons and Ordinances Files"
  106. 1283  LPRINT ,DATE$, TIME$
  107. 1284  LPRINT
  108. 1290  T2$ = F2$
  109. 1300  T3$ = F3$
  110. 1310  FOR J = 1 TO LEN(F3$)-1
  111. 1320   IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
  112. 1330  NEXT J
  113. 1340  T4$ = F4$
  114. 1350  IF LEFT$(T4$,1) = "M" THEN T4$ = "Male"
  115. 1360  IF LEFT$(T4$,1) = "F" THEN T4$ = "Female"
  116. 1370  T5 = CVS(F5$)
  117. 1380  T6 = CVS(F6$)
  118. 1390  T7 = CVS(F7$)
  119. 1400  T8$ = F8$
  120. 1410  T9$ = F9$
  121. 1420  T10$ = F10$
  122. 1430  T11$ = F11$
  123. 1440  T12$ = F12$
  124. 1450  T13$ = F13$
  125. 1460  T14$ = F14$
  126. 1470  T15$ = F15$
  127. 1480  T16$ = F16$
  128. 1490  T17$ = F17$
  129. 1500  T18$ = F18$
  130. 1510  T19$ = F19$
  131. 1520  REM Extract Ordinance Information
  132. 1530  GET #2, I
  133. 1540  U1 = CVS(O1$)
  134. 1541  REM bypass if no Ordinances Record Present
  135. 1542  IF U1 = 0 THEN GOSUB 8200 : GOTO 1780
  136. 1550  U2$ = O2$
  137. 1560  U3$ = O3$
  138. 1570  U4$ = O4$
  139. 1580  U5 = CVS(O5$)
  140. 1590  U6 = CVS(O6$)
  141. 1600  U7$ = O7$
  142. 1610  U8$ = O8$
  143. 1620  U9$ = O9$
  144. 1630  U10$ = O10$
  145. 1640  U11$ = O11$
  146. 1650  U12 = CVS(O12$)
  147. 1660  U13$ = O13$
  148. 1670  U14$ = O14$
  149. 1680  U15$ = O15$
  150. 1690  U16$ = O16$
  151. 1700  U17$ = O17$
  152. 1710  U18$ = O18$
  153. 1720  U19$ = O19$
  154. 1730  U20$ = O20$
  155. 1740  U21$ = O21$
  156. 1750  U22$ = O22$
  157. 1760  U23$ = O23$
  158. 1770  U24$ = O24$
  159. 1780  REM Print out of Personal Information
  160. 1790  LPRINT CHR$(27);"E";
  161. 1800  LPRINT ,"Personal Information"
  162. 1810  LPRINT CHR$(27);"F";
  163. 1820  LPRINT
  164. 1830  LPRINT ,"Record-Number:",T1
  165. 1840  LPRINT ,"Surname:",,T2$
  166. 1850  LPRINT ,"Given-names:",,T3$
  167. 1860  LPRINT ,"Sex:",,T4$
  168. 1870  LPRINT ,"Code:",,T5
  169. 1880  LPRINT ,"Father's Record-number:",T6
  170. 1881  LPRINT ,"Father's Name: ",
  171. 1882  IF T6 = 0 THEN LPRINT : GOTO 1890
  172. 1883  GET #1, T6
  173. 1884  TMP$ = F2$ : GOSUB 2420 : TT2$ = TMP$
  174. 1885  TMP$ = F3$ : GOSUB 2420 : TT3$ = TMP$
  175. 1886  LPRINT TT3$ + " " + TT2$
  176. 1890  LPRINT ,"Mother's Record-number:",T7
  177. 1891  LPRINT ,"Mother's Name: ",
  178. 1892  IF T7 = 0 THEN LPRINT : GOTO 1900
  179. 1893  GET #1, T7
  180. 1894  TMP$ = F2$ : GOSUB 2420 : TT2$ = TMP$
  181. 1895  TMP$ = F3$ : GOSUB 2420 : TT3$ = TMP$
  182. 1896  LPRINT TT3$ + " " + TT2$
  183. 1900  LPRINT ,"Birth-date:",,T8$
  184. 1910  LPRINT ,"Birth-city:",,T9$
  185. 1920  LPRINT ,"Birth-county:",,T10$
  186. 1930  LPRINT ,"Birth-state:",,T11$
  187. 1940  LPRINT ,"Death-date:",,T12$
  188. 1950  LPRINT ,"Death-city:",,T13$
  189. 1960  LPRINT ,"Death-county:",,T14$
  190. 1970  LPRINT ,"Death-state:",,T15$
  191. 1980  LPRINT ,"Burial-date:",,T16$
  192. 1990  LPRINT ,"Burial-city:",,T17$
  193. 2000  LPRINT ,"Burial-county:",T18$
  194. 2010  LPRINT ,"Burial-state:",,T19$
  195. 2020  LPRINT : LPRINT : LPRINT
  196. 2030  LPRINT CHR$(27);"E";
  197. 2040  LPRINT ,"Ordinance Information"
  198. 2050  LPRINT CHR$(27);"F";
  199. 2060  LPRINT
  200. 2070  REM Print the Ordinance Information
  201. 2080  LPRINT ,"Christening Date:",U2$
  202. 2090  LPRINT ,"Blessing Date:",U3$
  203. 2100  LPRINT ,"Sealed to Parents:",U4$
  204. 2110  LPRINT ,"Father's Record-Number:",U5
  205. 2111  LPRINT ,"Father's Name: ",
  206. 2112  IF U5 = 0 THEN LPRINT : GOTO 2120
  207. 2113  GET #1, U5
  208. 2114  TMP$ = F2$ : GOSUB 2420 : TT2$ = TMP$
  209. 2115  TMP$ = F3$ : GOSUB 2420 : TT3$ = TMP$
  210. 2116  LPRINT TT3$ + " " + TT2$
  211. 2120  LPRINT ,"Mother's Record-Number:",U6
  212. 2121  LPRINT ,"Mother's Name: ",
  213. 2122  IF U6 = 0 THEN LPRINT : GOTO 2130
  214. 2123  GET #1, U6
  215. 2124  TMP$ = F2$ : GOSUB 2420 : TT2$ = TMP$
  216. 2125  TMP$ = F3$ : GOSUB 2420 : TT3$ = TMP$
  217. 2126  LPRINT TT3$ + " " + TT2$
  218. 2130  LPRINT ,"Baptism Date:",,U7$
  219. 2140  LPRINT ,"Confirmation Date:",U8$
  220. 2150  LPRINT ,"Patriarchical Blessing:",U9$
  221. 2160  LPRINT ,"Endowment Date:",U10$
  222. 2170  IF LEFT$(T4$,1) = "M" THEN 2200
  223. 2180  LPRINT ,"Sealed to Husband Date:",U11$
  224. 2190  LPRINT ,"Husband's Record-Number:",U12
  225. 2191  LPRINT ,"Husband's Name: ",
  226. 2192  IF U12 = 0 THEN LPRINT : GOTO 2200
  227. 2193  GET #1, U12
  228. 2194  TMP$ = F2$ : GOSUB 2420 : TT2$ = TMP$
  229. 2195  TMP$ = F3$ : GOSUB 2420 : TT3$ = TMP$
  230. 2196  LPRINT TT3$ + " " + TT2$
  231. 2200  IF LEFT$(T4$,1) <> "M" THEN 2320
  232. 2210  LPRINT ,"Aaronic Priesthood Date:",U13$
  233. 2220  LPRINT ,"Deacon Date:",,U14$
  234. 2230  LPRINT ,"Teacher Date:",,U15$
  235. 2240  LPRINT ,"Priest Date:",,U16$
  236. 2250  LPRINT ,"Melchizedek Priesthood:",U17$
  237. 2260  LPRINT ,"Elder Date:",,U18$
  238. 2270  LPRINT ,"Seventy Date:",,U19$
  239. 2280  LPRINT ,"High Priest Date:",U20$
  240. 2290  LPRINT ,"Bishop Date:",,U21$
  241. 2300  LPRINT ,"Patriarch Date:",U22$
  242. 2310  LPRINT ,"Apostle Date:",,U23$
  243. 2320  LPRINT ,"Occupation:",,U24$
  244. 2330  LPRINT CHR$(12);
  245. 2340  RETURN
  246. 2350  NEXT I
  247. 2360  CLOSE #1
  248. 2370  CLOSE #2
  249. 2380  CLS : LOCATE 21,1
  250. 2390  PRINT "End of Program"
  251. 2400  LPRINT CHR$(12);
  252. 2410  RUN "a:menu"
  253. 2420  REM Right-trim routine
  254. 2425  TMP2$ = TMP$
  255. 2430  FOR TRM = 1 TO LEN(TMP$)-1
  256. 2440   IF RIGHT$(TMP$,1) = " " THEN TMP$ = LEFT$(TMP$,LEN(TMP$)-1) ELSE TRM = LEN(TMP2$)-1
  257. 2450  NEXT TRM
  258. 2460  RETURN
  259. 8200  REM Blank Ordinances if No Ord Record
  260. 8210  U2$  = "" : U3$  = "" : U4$  = ""
  261. 8220  U5   = 0  : U6   = 0  : U12  = 0
  262. 8230  U7$  = "" : U8$  = "" : U9$  = "" : U10$ = ""
  263. 8240  U11$ = "" : U13$ = "" : U14$ = "" : U15$ = ""
  264. 8250  U16$ = "" : U17$ = "" : U18$ = "" : U19$ = ""
  265. 8260  U20$ = "" : U21$ = "" : U22$ = "" : U23$ = ""
  266. 8270  U24$ = ""
  267. 8280  RETURN
  268.